home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0005_A Color Star Field.pas < prev    next >
Pascal/Delphi Source File  |  1993-07-16  |  4KB  |  134 lines
  1. {-------------------------- SCHNIPP -----------------------------}
  2.  
  3. {STARSCROLL.PAS geaenderte Fassung  }
  4.  
  5. {$A+,B-,D-,E-,F+,I+,L-,N-,O-,R-,S-,V-}
  6. {$M 64000,0,655360}
  7.  
  8. USES crt,graph,BGIDriv;                 {ich binde die Treiber ein}
  9.  
  10. CONST MaxStars=500;                     {auf meinem 386-25er muss ich in
  11.                                         der geaenderten Fassung schon 500
  12.                                         Sterne eintragen, damit es nur noch
  13.                                         ein wenig schneller ist als die alte
  14.                                         Fassung mit 100 Sternen ;-)}
  15.  
  16. TYPE Punkt=ARRAY[1..3] OF INTEGER;     {Siehe ganz unten Move()}
  17.  
  18. VAR
  19.    gd,gm,mpx,mpy,scal,a,b,e:integer;
  20.    Stars1,Stars:ARRAY[1..MaxStars] OF Punkt;
  21.  
  22.    mx,my,m2x,m2y,sop,                   {siehe Init}
  23.    act:INTEGER;
  24.  
  25. PROCEDURE dpunkt( x,y,z, Col:integer);
  26. VAR n:INTEGER;
  27.   BEGIN
  28.    n:=z+e;
  29.  
  30.    {n=Nenner, nur einmal berechnen, geht schneller}
  31.  
  32.    PutPixel(mpx+ (scal*x div n),mpy+ (scal*y div n),col);
  33.  
  34.                  {hier nur integer-operationen}
  35.   END;
  36.  
  37. PROCEDURE dline( x1,y1,z1,x2,y2,z2:integer);
  38. VAR n1,n2:INTEGER;
  39.   BEGIN
  40.    n1:=z1+e;n2:=z2+e;  {n1=Nenner fuer 1.Punkt, n2=Nenner fuer 2.Punkt}
  41.  
  42.    Line(mpx+(scal*(x1 div n1)),mpy+(scal*(y1 div n1)),
  43.         mpx+(scal*(x2 div n2)),mpy+(scal*(y2 div n2)));
  44.  
  45.       {Nix mit Round(xxx / nX), dauert zu lange: Integer ->Real ->Integer}
  46.   END;
  47.  
  48. PROCEDURE Init;
  49. begin
  50.  act:=1;
  51.  e:=1;
  52.  scal := 2;
  53.  
  54.  mx:=getmaxx;     {damit man es auch in EgaLo oder anderen GModes}
  55.  m2x:=mx shr 1;   {betreiben kann, alle Werte abhaengig von MaximalX und}
  56.  my:=getmaxy;     {MaximalY}
  57.  m2y:=my shr 1;
  58.  mpx:=m2x;
  59.  mpy:=m2y-(mpy shr 1);
  60.  
  61.  sop:=sizeof(punkt);  {Schreibt sich leichter :-) }
  62. end;
  63.  
  64. BEGIN
  65.   Randomize;
  66.   gd:=ega;
  67.   gm:=egahi;
  68.  
  69.   if RegisterBGIdriver(@EgaVgaDriverProc) < 0 then halt(255);
  70.  
  71.   InitGraph(gd,gm,'');  {oder InitGraph(gd,gm,'PathToDriver');}
  72.   Init;
  73.   FOR a:=0 TO 15 DO  SetRGBPalette(a,a*3,a*3,a*3);
  74.   FOR a:=1 TO MaxStars DO
  75.     BEGIN
  76.       Stars[a,1]:=Random(mx)-m2x;
  77.       Stars[a,2]:=Random(my)-m2y;
  78.       Stars[a,3]:=Random(30)+1;
  79.     END;
  80.  
  81.   Move(Stars,Stars1,SoP*MaxStars);      {man sollte Stars1 initialisieren}
  82.                                         {wenn man es benutzt}
  83.   SetColor(15);
  84.   SetVisualPage(act);
  85.  
  86.   {AB hier kommt es auf Geschwindigkeit an}
  87.  
  88.   REPEAT
  89.             {IF act=0 THEN act:=1 ELSE act:=0; dauert zu lange, deshalb:}
  90.             {wenn (act)=1 -> act:=1-(1) = 0  wenn (act)=0 -> act:=1-(0)=1}
  91.     act:=1-act;
  92.  
  93.     SetActivePage(act);
  94.     FOR a:= 1 TO MaxStars DO
  95.     BEGIN
  96.       Stars[a,3]:=Stars[a,3]-1;
  97.       IF stars[a,3]= 0 THEN
  98.       BEGIN
  99.         Stars[a,1]:=Random(mx)-m2x;
  100.         Stars[a,2]:=Random(my)-m2y;
  101.         Stars[a,3]:=30;
  102.       END;
  103.       dpunkt(Stars[a,1],Stars[a,2],Stars[a,3],15-(stars[a,3] shr 1));
  104.  
  105.                         {round(xxx/2) dauert zu lange {shr 1 = div 2 }
  106.     END;
  107.     SetVisualPage(act);
  108.  
  109.     act:=1-act;   {s.o.}
  110.  
  111.     SetActivePage(act);
  112.     FOR a:=1 TO MaxStars DO
  113.     BEGIN
  114.       dpunkt(Stars1[a,1],Stars1[a,2],Stars1[a,3],0);
  115.  
  116.       {Wenn man Stars1 nicht initialisierst kommt es schon mal vor, dass
  117.        man einen Division by Zero Error beim ersten beim 1. Aufruf erhaelt}
  118.  
  119.       move(stars[a],stars1[a],sop);
  120.  
  121.       {nicht einzeln uebertragen, Move ist schneller, deshalb auch Type Punkt}
  122.  
  123.     END;
  124.  
  125.     act:=1-act; {s.o.}
  126.  
  127.   UNTIL KeyPressed;
  128.  
  129.   closegraph;          {Nicht vergessen !!!! ;-) }
  130. END.
  131.  
  132. {------------------------- SCHNAPP --------------------------------------}
  133.  
  134.